MODULE = PlPN          PACKAGE = PlPN::Menu

#
# Pod::Html is kind of brain-dead:
#
# Place Z<> between function names and parentheses, otherwise Pod::Html
# assumes you meant to put C<...> around it
#
# Put explicit text in all links L<use my text, stupid|some::perl::module>,
# otherwise Pod::Html assumes you want "the X manpage". (Does not apply to
# relative links withing this file.)
#
# It also assumes you want a link if you have C<...> with text matching a
# potential link target. The only way I've found around that is to split it
# up into multiple pieces: C<wo>C<rd>. Looks correct in the resulting HTML,
# but it's ugly to have <code>wo</code><code>rd</code> in the source, and I
# shouldn't have to do it.
#

=head1 NAME

PlPN::Menu - The menu object

=head1 SYNOPSIS
	
	use PlPN qw(PN);
	
	sub handler {
		# do something
	}
	
	my $menu = new PlPN::Menu("menu",
		[ {  text => 'Click me!', id => "item", handler => \&handler } ]
	);
	
	PN->AddPluginMenuItems($menu);
	
	# etc.

=head1 DESCRIPTION

Adds menu items to Programmer's Notepad's C<Extensions> menu.

=head2 Unique ids

The extension interface for menus does not allow for removing or editing
menus once they have been added. The Perl implementation requires a unique
id for all top-level menus, so that if your code is executed more than once
(for example, if a script is executed more than once, or if the Perl
interpreter is cycled), your menu can be recognized as having already been
added.

Every menu item must also have
an id. Every such item uses the same C++ menu handler, and that menu handler
uses the id to find the perl handler.

If you try to add two top-level menus with the same id, the second will not
be added. Even worse, if any of the menu items anywhere in its hierarchy
happen to have the same id, the handler or submenus for the first item will
be overwritten.

Therefore, it is very important that every top-level menu and every menu
item handler be associated with a unique id.

NOTE: While ids must be unique within their scope (menu or menu item) within
a single running instance of Programmer's Notepad, they do not have to be
unique across scopes. That is, a menu and a menu item may have the same id
without causing a collision.

=head2 Id format

An id is a sequence of 4 bytes. The easiest way to do this is a 4-byte
string (note: B<bytes>, not characters), but you can also use pack to create
your id. With the 95 printable characters of 7-bit ASCII (each of which
takes up one byte in Perl's native utf8 encoding), there are over 78 million
possible combinations. Merely adding the space character increases this by
over 3 million more. Using the control characters as well gives over 260
million possibilities. So it shouldn't be too difficult to come up with
unique ids, as long as you avoid things like C<mnu1>, C<mnu2>, etc.

Under no circumstances should you follow the example above and use ids like
C<menu> and C<item>.

=head2 Menu item format

A menu item is a hashref. It may be blessed into class, but it does not have
to be. It has the following keys:

=over

=item C<text>

This is the menu text. It is required, and cannot be changed once the
menu has been added.

If you pass the text C<->, a separator will be created.

=item C<id>

This is the unique id.

An id is still required for separators, but it is safe to pass the same id
for all separators.

=item C<submenu>

This is an instance of C<PlPN::Menu> (or a derived class).

=item C<handler>

This is a subref or a string containing a fully-qualified subname. It will
be called with the menu item itself and the id that was used to identify it
as the parameters. (The id is supplied because it is possible to change the
id in the menu item hashref itself.)

=item C<method>

If the menu item is a blessed hashref, this is a method of the class it has
been blessed into. Note that it should be a string containing the method
name and not a subref. It will be called with the same parameters as a
C<hand>C<ler>.

=back

A menu item must supply one of C<sub>C<menu>, C<hand>C<ler>, or
C<met>C<hod>, unless it is a separator.

=head1 CONSTRUCTOR

=over

=item new PlPN::Menu($id, $items)

Creates a menu object. If you implement your own constructor in a derived
class, you B<must> call this class's version, because it creates the
associated C++ object. The blessed hashref returned by C<new> allows access
to the underlying C++ object, which is used by
L<PlPN::PN::AddPluginMenuItems|PlPN::PN/AddPluginMenuItems>. In other words,
you're pretty much stuck with this object.

C<$id> is required for top-level menus. For submenus, it is safe to omit the
id. There is no way to set the id after creation, so if you create a
derived class, you must pass the id to the base class constructor.

C<$items> is an arrayref of menu items which, if provided, will be placed in
the object hashref with the key C<items>. If you create a derived class, you
can inherit this storage mechanism or define your own.

=back

=cut

PerlMenu*
PerlMenu::new(SV* one = NULL, SV* two = NULL)
	CODE:
		extensions::cookie_t cookie = 0;
		SV* items = NULL;
		
		if (one != NULL) {
			// if one is an aref, it's our items
			if (SvROK(one)) {
				items = one;
			}
			// else one is the code, and two is our items
			else {
				cookie = code_2_cookie(one);
				items = two;
			}
		}
		
		RETVAL = new PerlMenu(CLASS, cookie);
		if (items != NULL) {
			SvREFCNT_inc(items);
			hv_store(
				(HV*)SvRV(RETVAL->GetPerlObj()),	/* target */
				"items",							/* key */
				5,									/* key length */
				items,								/* value */
				0									/* hash; 0 means let perl compute */
			);
		}
	OUTPUT:
		RETVAL

# Strangely, I keep getting an error about PerlMenu* not being defined in the typemap
# - even though GetItemCount() has no problem with it. So I had to comment it out
# and roll my own
#void
#PerlMenu::DESTROY()

void
DESTROY(perl_obj);
		SV* perl_obj;
	CODE:
		PerlMenu* pm = (PerlMenu*)retrieve_cpp_object(perl_obj);
		delete pm;

FALLBACK: TRUE

bool
eq(a,b,swap)
		PerlMenu* a;
		PerlMenu* b;
		IV swap;
	OVERLOAD: ==
	CODE:
		RETVAL = (a == b);
	OUTPUT:
		RETVAL

#
# xsubpp only generates the following code for the module, not for the
# individual packages. In our case, that's less than useful, because the
# module does not, in fact, have overloaded operators.
# See the boot section in the generated code for an explanation of what the
# following code does
#
BOOT:
PL_amagic_generation++;
sv_setsv(
	get_sv( "PlPN::Menu::()", TRUE ),
	&PL_sv_yes	// or &PL_sv_no or &PL_sv_undef
);
(void)newXSproto_portable("PlPN::Menu::()", XS_PlPN_nil, file, "$$$");

=head1 METHODS

=over

=item GetItemCountZ<>()

Once you add your menu (via
L<PlPN::PN::AddPluginMenuItems|PlPN::PN/AddPluginMenuItems>) this method
will be called by the system. It must return an integer indicating the
number of items the menu will provide. The default version simply returns
the number of elements in the C<items> arrayref.

=cut

int
PerlMenu::GetItemCount()
	CODE:
		SV** items = hv_fetch(
			(HV*)SvRV(THIS->GetPerlObj()),	/* target */
			"items",						/* key */
			5,								/* key length */
			0								/* is this fetch part of a store? */
		);
		if (items == NULL)
			RETVAL = 0;
		else
			RETVAL = av_len((AV*)SvRV(*items)) + 1;
	OUTPUT:
		RETVAL

=item GetItemZ<>($index)

Once you add your menu (via
L<PlPN::PN::AddPluginMenuItems|PlPN::PN/AddPluginMenuItems>) this method
will be called by the system. It must return a menu item. The default
version returns the C<$index>th element from the C<items> arrayref.

=cut

SV*
PerlMenu::GetItem(index)
		int index;
	CODE:
		SV** items = hv_fetch(
			(HV*)SvRV(THIS->GetPerlObj()),	/* target */
			"items",						/* key */
			5,								/* key length */
			0								/* is this fetch part of a store? */
		);
		RETVAL = NULL;
		if (items != NULL) {
			SV** val = av_fetch(
				(AV*)SvRV(*items),	/* target */
				index,				/* index */
				0					/* is this fetch part of a store? */
			);
			if (val != NULL) 
				RETVAL = *val;
		}
	OUTPUT:
		RETVAL

=back

=head1 COPYRIGHT and LICENCE

Copyright (c) 2012 Sean Healy. All rights reserved.

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=cut
